home *** CD-ROM | disk | FTP | other *** search
/ Aminet 37 / Aminet 37 (2000)(Schatztruhe)[!][Jun 2000].iso / Aminet / misc / emu / unBINSCII.lha / unBINSCII.p < prev    next >
Encoding:
Text File  |  2000-03-08  |  3.6 KB  |  150 lines
  1. program unBINSCII;
  2.  
  3. var firstTime, match: Boolean;
  4.     size, last, limit, i, j, k: integer;
  5.     fileSize, chunkSize, lines: long;
  6.     fileName: string[32];
  7.     xlate: string[64];
  8.     line: string[132];
  9.     values: array[0..63] of byte;
  10.     out: array[0..47] of byte;
  11.     a: text;
  12.     b: file of byte;
  13.  
  14. procedure Convert4x6to3x8(iX, oX: integer);
  15.   var i, j: integer;
  16.       temp: long;
  17.       bytes: array[0..3] of byte;
  18.   begin
  19.     for i := 0 to 3
  20.       do begin
  21.         j := 0;
  22.         repeat
  23.           j := j + 1;
  24.           match := line[iX + i + 1] = xlate[j]
  25.         until match or (j = 64);
  26.         if match
  27.             then bytes[i] := j - 1
  28.           else bytes[i] := 255
  29.       end;
  30.     temp := (long(bytes[3]) and $3F) shl 18
  31.              + (bytes[2] and $3F) shl 12
  32.              + (bytes[1] and $3F) shl 6
  33.              + bytes[0] and $3F;
  34.     out[oX] := temp shr 16;
  35.     out[oX + 1] := (temp shr 8) and $FF;
  36.     out[oX + 2] := temp and $FF
  37.   end;
  38.  
  39. function reverse3: long;
  40.   begin
  41.     reverse3 := out[2] * 65536 + out[1] * 256 + out[0]
  42.   end;
  43.  
  44. begin
  45.   firstTime := true;
  46.   if ParamCount <> 1
  47.       then begin
  48.         writeln('Usage: unBINSCII pathname');
  49.         halt(20)
  50.       end
  51.     else fileName := ParamStr(1);
  52.   assign(a, fileName);
  53.   reset(a);
  54.   repeat
  55.     repeat
  56.       readln(a, line);
  57.       size := length(line);
  58.       if line[size] = #$0D
  59.           then delete(line, size, 1)
  60.     until (line = 'FiLeStArTfIlEsTaRt') or eof(a);
  61.     if eof(a)
  62.         then begin
  63.           writeln('Unexpected EOF!');
  64.           close(a);
  65.           close(b);
  66.           halt(20)
  67.         end;
  68.     readln(a, line);
  69.     size := length(line);
  70.     if line[size] = #$0D
  71.         then delete(line, size, 1);
  72.     if length(line) <> 64
  73.         then begin
  74.           writeln('Translate table error!');
  75.           close(a);
  76.           close(b);
  77.           halt(20)
  78.         end
  79.       else xlate := line;
  80.     readln(a, line);
  81.     size := length(line);
  82.     if line[size] = #$0D
  83.         then delete(line, size, 1);
  84.     if length(line) <> 52
  85.         then begin
  86.           writeln('File attributes error');
  87.           close(a);
  88.           close(b);
  89.           halt(20)
  90.         end;
  91.     if firstTime
  92.         then begin
  93.           size := ord(line[1]) - 64;
  94.           fileName := copy(line, 2, size);
  95.           writeln('The output file will be named ''', fileName, '''');
  96.           assign(b, fileName);
  97.           rewrite(b);
  98.           Convert4x6to3x8(16, 0);
  99.           fileSize := reverse3;
  100.           writeln('File size = ',fileSize)
  101.           firstTime := false
  102.         end;
  103.     Convert4x6to3x8(44, 0);
  104.     chunkSize := reverse3;
  105.     writeln('  Chunk size = ', chunkSize);
  106.     lines := chunkSize div 48;
  107.     last := chunkSize mod 48;
  108.     if last <> 0
  109.         then lines := lines + 1;
  110.     limit := 47;
  111.     for i := 1 to lines
  112.       do begin
  113.         readln(a, line);
  114.         size := length(line);
  115.         if line[size] = #$0D
  116.             then delete(line, size, 1);
  117.         if length(line) <> 64
  118.             then begin
  119.               writeln('Data line error!');
  120.               close(a);
  121.               close(b);
  122.               halt(20)
  123.             end;
  124.         k := 0;
  125.         for j := 0 to 15
  126.           do begin
  127.             Convert4x6to3x8(j * 4, k);
  128.             k := k + 3
  129.           end;
  130.         if (i = lines) and (last <> 0)
  131.             then limit := last - 1;
  132.         for j := 0 to limit
  133.           do write(b, out[j])
  134.       end;
  135.     readln(a, line);
  136.     size := length(line);
  137.     if line[size] = #$0D
  138.         then delete(line, size, 1);
  139.     if length(line) <> 4
  140.         then begin
  141.           writeln('Wrong size chunk trailer!');
  142.           close(a);
  143.           close(b);
  144.           halt(20)
  145.         end
  146.   until eof(a);
  147.   close(b);
  148.   close(a)
  149. end.
  150.